perm filename RESTP.F4[PAG,LCS] blob sn#638895 filedate 1982-01-29 generic text, type T, neo UTF8
C THIS ROUTINE GATHERS NUMBERED RESTS AND THINGS NEARBY AT END OF A LINE AND LATER
C INSERTS THEM AT BEGINNING OF NEXT LINE.

	SUBROUTINE RESTP
C   -- Copyright 1982 by Leland Smith --
	COMMON /POSI/STFF(8),JJ2,JPQ /PX/KPN(1) /Q/Q(1)
	COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS 
	COMMON/XRN/RN(1) /XXX/LK,LP,JY /JN/J,N /IRST/IRST
	1 /RSP/KNM(1) /ENDL/ENDLN,KQ,NAME,NMPG,SPCNT
	DIMENSION MM(1),NN(1),RX(100),NNX(30)
C RX AND NNX ARRAYS STORE THINGS AND CODE NUMS FOR INSERT TO NEXT LINE.
	EQUIVALENCE (MX,RX),(MM,RN),(NN,RN(501))

	IF(IRST.EQ.0)GO TO 3
	IF(NN(1).NE.2)GO TO 4
C NEXT IS A REST
	IF(Q(MM(1)-3).LT.6)GO TO 4
	IF(Q(MM(1)+5).LT.-3)GO TO 4
C NEXT IS NUMBERED REST.
	M=3
  	INSRTS=0
16	IF(RX(M).EQ.2)GO TO 15
C LOOK FOR REST HELD FROM LAST TIME THROUGH
	M=M+RX(M-1)+3
  	INSRTS=INSRTS+1
	GO TO 16
C NOW FOUND  NUMB. OF BARS REST HELD OVER. (IN RX(M+7) )
15	Q(MM(1)+5)=Q(MM(1)+5)+RX(M+7)
	IRST=0
  	IF(INSRTS.EQ.0)GO TO 3
	MX=M-2
C NOW SHIFT IN THINGS BEFORE A NUMBERED REST.

4	IF(INSRTS.GT.0)GO TO 44
	IRST=0
	RETURN
C ABOVE LINES ADDED 11/28/80  WHY NEEDED????
44	MX=MX-1
	RE=3.*INSRTS
	CALL SHFTQ(RE)
C ******* 1/16/82  ALLOWS 3 UNITS FOR EACH INSERTED ITEM.
C  PUSHES DATA TO RIGHT A BIT TO LEAVE SPACE FOR INSERTS
	DO 9 K=KPN(JJ2-1),1,-1
9	Q(K+MX)=Q(K)
	RE=ENDLN+3
CXX	RE=ENDLN
	J=INSRTS
C  THE WD CNT
	K=5
21	RX(K)=RE    
	IF(J.EQ.1)GO TO 10
	J=J-1
	K=RX(K-3)+3+K
	RE=RE+3
C SETS POS. FOR ITEMS INSERTED AT FRONT OF LINE.
	GO TO 21
10	CALL RLOOP(Q,RX(2),MX)

	DO 5 K=N+1,1,-1
	J=K+INSRTS
	NN(J)=NN(K)
	MM(J)=MM(K)+MX
C  SHIFT EVERYTHING
5	KPN(J)=KPN(K)+MX

  	N=N+INSRTS
  	JJ2=JJ2+INSRTS
	KQ=KQ+MX
	J=2
	K=2
6	M=RX(K)+3
	KPN(J)=KPN(J-1)+M
	J=J+1
	K=K+M
	IF(K.LT.MX)GO TO 6
	IRST=0
	DO 7 K=1,INSRTS
	MM(K)=KPN(K)+3
C  ASSUMES NO SLURS, HORIZ. LINES, ETC. AT THIS POINT.
CC7	NN(K)=CODEN(KPN,K,Q,J)
7	NN(K)=NNX(K)

3	DO 1 K=N,1,-1
	J=NN(K)
	IF(J.GT.16)RETURN
	IF(J.EQ.1)RETURN
	IF(J.NE.4)GO TO 23
	IF(Q(MM(K)+1).GE.1000)RETURN
C  NO RESTS COMBINED OVER DOUBLE BARS.
23	IF(J.NE.2)GO TO 1
	MK=K  
	IF(K.EQ.1)GO TO 13

17	M=MK-1
	IF(NN(M).EQ.4)GO TO 13
C LOOK FOR BAR LINE BEFORE REST
	MK=MK-1
C GET RIGHT GROUP OF ITEMS TO SAVE FOR NEXT TIME.(EVERYTHING BACK TO BAR.)
	IF(MK.GT.1)GO TO 17

13	M=MM(K)
	IF(Q(M-3).LT.6)RETURN
	IF(Q(M+5).LT.-3)RETURN
C AVOID REPEAT BAR SIGN (P8=-5 OR -4)
	IRST=-1
C  NOW FOUND NUMBERED REST
	IF(MK.NE.1)GO TO 8
	IRST=-2
C  -2 = ONLY RESTS ON THIS LINE.
8	M=1
	RE=ENDLN+3
	MX=0

	J=MK
14	IF(NN(J).EQ.-1)MK=J+1  
C***** CATCHES EVERYTHING TO LEFT OF -1 ITEM. (A P6,P8,P9)  *****
12	J=J+1
	IF(J.LE.N)GO TO 14
   	DO 20 J=MK,N
CC	IF(NN(J).EQ.-1)GO TO 20
C SKIP IF -1 FOUND (REFERS TO PARAM OTHER THAN P3)
	JX=MM(J)
	MX=MX+1
	NNX(MX)=NN(J)
c  save nn data for later insert (at 7)
	Q(JX)=RE
	RE=RE+3
	LX=Q(JX-3)+3
	JX=JX-4
	DO 2 JA=1,LX
	M=M+1
2	RX(M)=Q(JA+JX)
C RX SAVES STUFF FOR NEXT TIME AROUND.  THEN IT GETS SHIFTED TO FRONT OF Q ARRAY.
20	CONTINUE
	MX=M
C WD CNT
	JJ2=JJ2-N+MK-1
	INSRTS =N-MK+1
C INSRTS SAVES COUNT O ITEMS TO BE INSERTED
	N=MK-1
	IF(IRST.EQ.-2)N=-N
	RETURN
1	CONTINUE
	END